home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pcscheme / geneva / sources.exe / SOURCES / ASM / WINDOW.ASM < prev   
Encoding:
Assembly Source File  |  1993-09-28  |  15.4 KB  |  593 lines
  1. ;* WINDOW.ASM
  2. ;************************************************************************
  3. ;*                                    *
  4. ;*        PC Scheme/Geneva 4.00 Borland TASM code            *
  5. ;*                                    *
  6. ;* (c) 1985-1988 by Texas Instruments, Inc. See COPYRIGHT.TXT        *
  7. ;* (c) 1992 by L. Bartholdi & M. Vuilleumier, University of Geneva    *
  8. ;*                                    *
  9. ;*----------------------------------------------------------------------*
  10. ;*                                    *
  11. ;*        Windowed I/O support (interpreter support)        *
  12. ;*                                    *
  13. ;*----------------------------------------------------------------------*
  14. ;*                                    *
  15. ;* Created by: John Jensen        Date: 1985            *
  16. ;* Revision history:                            *
  17. ;* - 7 Jan 87:    added random I/O (dbs)                    *
  18. ;* - 18 Jun 92:    Renaissance (Borland Compilers, ...)            *
  19. ;*                                    *
  20. ;*                    ``In nomine omnipotentii dei''    *
  21. ;************************************************************************
  22. IDEAL
  23. %PAGESIZE    60, 132
  24. MODEL    small
  25. LOCALS    @@
  26.  
  27.     INCLUDE    "scheme.ash"
  28.     INCLUDE "interprt.ash"
  29.  
  30. PORTATTR =    PORT_BINARY+TYPE_WINDOW+READ_EXCLUSIVE+WRITE_EXCLUSIVE
  31. NUM_FLDS =    13
  32.  
  33. DATASEG
  34.  
  35. defaults DW    0, 0, 0, 0, 0, 0    ; default values of window object
  36.     DW    -1, 7, 1, 0, 0
  37.  
  38. UDATASEG
  39.  
  40. wnlines    DW    ?             ; number of lines
  41. wncols    DW    ?             ; number of columns
  42. wulline    DW    ?             ; upper-left line number
  43. wulcol    DW    ?             ; upper-left column number
  44.  
  45. CODESEG
  46. ;************************************************************************
  47. ;*        Allocate a window object                *
  48. ;************************************************************************
  49. PROC    make_win
  50.     get1op
  51.     save    <si>
  52.     add    ax, offset regs     ; compute register address
  53.     mov    bx, ax
  54.     mov    si, [(REG bx).disp]
  55.     mov    bx, [(REG bx).page]
  56.     mov    [tmp_reg.disp], si     ; save window label pointer
  57.     mov    [tmp_reg.page], bx
  58.     cmp    [ptype+bx], STRTYPE    ; check string type
  59.     je    @@noerror
  60.     or    bx, bx
  61.     jz    @@noerror         ; null window label
  62.  
  63.     lea    bx, [@@msg]
  64. DATASEG
  65. @@msg    DB    "%MAKE_WINDOW", 0
  66. CODESEG
  67.     jmp    src_err         ; display error message
  68.  
  69. @@noerror:
  70.     mov    bx, SIZE PORTDEF - SIZE POINTER    ; get object length
  71.     mov    cx, PORTTYPE
  72.     push    ax
  73.     call    alloc_block C, ax, cx, bx
  74.     pop    bx            ; restore window register address
  75.     mov    di, [(REG bx).disp]
  76.     mov    bx, [(REG bx).page]
  77.     ldpage    es, bx
  78.     shr    bx, 1
  79.     push    es            ; save es over C call
  80.     call    zero_blk C, bx, di    ; zero window object
  81.     pop    es
  82.     mov    [(PORTDEF es:di).pflags], PORTATTR
  83.     mov    ax, di
  84.     add    di, 10             ; position to move default values
  85.     lea    si, [defaults]         ; address of default values
  86.     mov    cx, NUM_FLDS-1         ; length of defaults
  87.     rep    movsw             ; move defaults into object
  88.     mov    di, ax
  89.     call    get_max_rows C
  90.     mov    [(PORTDEF es:di).nlines], ax
  91.     call    get_max_cols C
  92.     mov    [(PORTDEF es:di).ncols], ax
  93.     mov    ax, [tmp_reg.page]
  94.     mov    bx, [tmp_reg.disp]
  95.     mov    [(PORTDEF es:di).ptr.page], al; store window label pointer
  96.     mov    [(PORTDEF es:di).ptr.disp], bx
  97.     jmp    next_pc
  98. ENDP    make_win
  99.  
  100. ;************************************************************************
  101. ;            Get Window Attributes
  102. ; Get Window Attributes was translated from C. The following C comments
  103. ; show the mappings of the arguments to get-window-attributes to their
  104. ; actual locations within the port object.
  105. ;
  106. ;
  107. ;#define NUM_FIELDS 12
  108. ;static int defaults[NUM_FIELDS] = {0,   /* cursor line number */
  109. ;                                   0,   /* cursor column number */
  110. ;                                   0,   /* upper left corner line number */
  111. ;                                   0,   /* upper left corner column number */
  112. ;                                  25,   /* number of lines */
  113. ;                                  80,   /* number of columns */
  114. ;                                  -1,   /* no border */
  115. ;                                  15,   /* text high intensity, enable */
  116. ;                                   1,   /* wrap enabled */
  117. ;                                   0,   /* current buffer position */
  118. ;                                   0,   /* current buffer end */
  119. ;TRANSCRIPT+BINARY+WINDOW+OPEN+READ_WRITE}; /* port attributes */
  120. ;static int map_attr[NUM_FIELDS] = {10,12,14,16,18,20,22,24,26,28,30,6};
  121. ;************************************************************************
  122. PROC    get_wind
  123.     get2op
  124.     save    <si>             ; save the location pointer
  125.     xor    bx, bx
  126.     mov    bl, ah
  127.     add    bx, offset regs     ; compute address of register
  128.     xor    ah, ah
  129.     add    ax, offset regs
  130.     save    <ax>             ; save registers
  131.     push    bx
  132.     mov    cx, 1
  133.     call    get_port C, ax, cx     ; get the port object
  134.     pop    bx
  135.     mov    si, [tmp_reg.page]
  136.     cmp    [ptype+si], PORTTYPE
  137.     jne    @@error
  138.     cmp    [(REG bx).bpage], SPECFIX*2
  139.     jne    @@error
  140.     mov    bx, [(REG bx).disp]    ; get the value
  141.     or    bx, bx
  142.     jl    @@error
  143.     cmp    bx, NUM_FLDS
  144.     jng    @@proceed
  145. @@error:
  146.     lea    bx, [$$msgreify]
  147. DATASEG
  148. $$msgreify DB    "%REIFY-PORT", 0
  149. CODESEG
  150.     jmp    src_err         ; link to error handler
  151.  
  152. @@proceed:
  153.     ldpage    es, si         ; get page address
  154.     mov    si, [tmp_reg.disp]
  155.     restore <ax>
  156.     mov    di, ax
  157.     mov    [(REG di).bpage], SPECFIX*2
  158.     cmp    bx, 13
  159.     jne    @@not13
  160.     mov    ax, [(PORTDEF es:si).ptr.disp]
  161.     mov    dl, [(PORTDEF es:si).ptr.page]
  162.     mov    [(REG di).disp], ax
  163.     mov    [(REG di).bpage], dl
  164.     jmp    next_pc
  165. @@not13:
  166.     cmp    bx, 12
  167.     jne    @@not12
  168.     mov    ax, [(PORTDEF es:si).chunk]; get chunk number
  169.     jmp    @@common
  170. @@not12:
  171.     cmp    bx, 11
  172.     jne    @@not11
  173.     mov    bx, [(PORTDEF es:si).pflags]
  174.     mov    ax, bx
  175.     and    ax, PORT_FLUSHED    ; 10000000b
  176.     xor    ax, PORT_FLUSHED
  177.     mov    cx, bx
  178.     and    cx, PORT_BINARY
  179.     shr    cx, 1            ; 00100000b
  180.     or    ax, cx
  181.     test    bx, READ_MODE+WRITE_MODE
  182.     jz    @@open_done
  183.     or    ax, 00001000b
  184. @@open_done:
  185.     test    bx, WRITE_MODE
  186.     jz    @@mode_done
  187.     or    ax, 00000001b
  188.     test    bx, READ_MODE
  189.     jz    @@mode_done
  190.     xor    ax, 00000011b
  191. @@mode_done:
  192.     mov    cx, bx
  193.     and    cx, PORT_TYPE
  194.     cmp    cx, TYPE_STRING
  195.     jne    @@not_string
  196.     or    ax, 01000100b
  197.     jmp    @@type_done
  198. @@not_string:
  199.     cmp    cx, TYPE_FILE
  200.     je    @@type_done
  201.     or    ax, 00000100b
  202. @@type_done:
  203.     test    [(PORTDEF es:si).flags], W_TRANS
  204.     jz    @@common
  205.     or    ax, 00010000b
  206.     jmp    @@common
  207. @@not11:
  208.     shl    bx, 1             ; get the word offset
  209.     mov    ax, [(PORTDEF es:si+bx).curline]
  210. @@common:
  211.     test    [(PORTDEF es:si).pflags], PORT_TYPE
  212.     jnz    @@notwindow
  213.     mov    [(REG di).disp], ax
  214.     jmp    next_pc
  215.  
  216. @@notwindow:
  217.     xor    bx, bx
  218.     call    long2int C, di, ax, bx    ; convert to scheme integer
  219.     jmp    next_pc
  220. ENDP    get_wind
  221.  
  222. ;************************************************************************
  223. ;                  Modify Transcript File Status
  224. ;************************************************************************
  225. PROC    trns_chg
  226.     get1op
  227.     save    <si>
  228.     add    ax, offset regs     ; compute address of register
  229.     mov    bx, ax
  230.     mov    si, [(REG bx).disp]
  231.     mov    bx, [(REG bx).page]
  232.     cmp    [ptype+bx], PORTTYPE    ; check type
  233.     jne    @@error
  234.     ldpage    es, bx             ; get page address
  235.     mov    ax, [(PORTDEF es:si).pflags]
  236.     test    ax, WRITE_OPEN        ; open for write ?
  237.     jz    @@error
  238.     mov    [trns_reg.page], bx
  239.     mov    [trns_reg.disp], si
  240.     jmp    next_pc
  241. @@error:
  242.     xor    ax, ax
  243.     mov    [trns_reg.page], ax
  244.     mov    [trns_reg.disp], ax
  245.     jmp    next_pc
  246. ENDP    trns_chg
  247.  
  248. ;************************************************************************
  249. ;                  Save Window Contents
  250. ;************************************************************************
  251. PROC    save_win
  252.     get1op
  253.     save    <si>
  254.     add    ax, offset regs     ; compute address of register
  255.     xor    bx, bx
  256.     save    <ax>
  257.     call    get_port C, ax, bx     ; get port object
  258.     mov    bx, [tmp_reg.page]
  259.     cmp    [ptype+bx], PORTTYPE    ; check port type
  260.     je    @@typeok
  261. @@error:
  262.     lea    bx, [@@msg]
  263. DATASEG
  264. @@msg    DB    "WINDOW-SAVE-CONTENTS", 0
  265. CODESEG
  266.     jmp    src_err         ; link to error handler
  267. @@typeok:
  268.     ldpage    es, bx         ; get page address
  269.     mov    di, [tmp_reg.disp]
  270.     test    [(PORTDEF es:di).pflags], PORT_TYPE
  271.     jnz    @@error
  272.     mov    ax, [(PORTDEF es:di).ulline]
  273.     mov    bx, [(PORTDEF es:di).ulcol]
  274.     mov    cx, [(PORTDEF es:di).nlines]
  275.     mov    dx, [(PORTDEF es:di).ncols]
  276.     mov    [wulline], ax
  277.     mov    [wulcol], bx
  278.     mov    [wnlines], cx
  279.     mov    [wncols], dx
  280.     mov    ax, [(PORTDEF es:di).border]
  281.     cmp    ax, -1             ; bordered?
  282.     je    @@noborder
  283.     lea    ax, [wulline]
  284.     lea    bx, [wulcol]
  285.     lea    cx, [wnlines]
  286.     lea    dx, [wncols]
  287.     call    adj4bord C, ax, cx, bx, dx ; adjust window region
  288. @@noborder:
  289.     mov    ax, [wnlines]
  290.     mov    bx, [wncols]
  291.     mul    bl            ; length of string to save window
  292.     shl    ax, 1
  293.     add    ax, 2
  294.     mov    di, ax
  295.     restore <ax>
  296.     mov    cx, STRTYPE         ; string type
  297.     call    alloc_block C, ax, cx, di
  298.     restore <ax>
  299.     call    save_scr C, ax, [wulline], [wulcol], [wnlines], [wncols], di
  300.     jmp    next_pc
  301. ENDP    save_win
  302.  
  303. ;************************************************************************
  304. ;                  Restore Window Contents
  305. ;************************************************************************
  306. PROC    rest_win
  307.     get2op
  308.     save    <si>
  309.     xor    bx, bx
  310.     mov    bl, ah
  311.     add    bx, offset regs     ; compute address of registers
  312.     xor    ah, ah
  313.     add    ax, offset regs
  314.     save    <bx>
  315.     xor    cx, cx
  316.     call    get_port C, ax, cx     ; get the port object
  317.     restore <bx>
  318.     mov    si, [(REG bx).page]
  319.     cmp    [ptype+si], STRTYPE
  320.     je    @@stillok
  321. @@error:
  322.     lea    bx, [@@msg]
  323. DATASEG
  324. @@msg    DB    "WINDOW-RESTORE-CONTENTS", 0
  325. CODESEG
  326.     jmp    src_err
  327.  
  328. @@stillok:
  329.     mov    di, [tmp_reg.page]
  330.     cmp    [ptype+di], PORTTYPE
  331.     jne    @@error
  332.     ldpage    es, di         ; get page address
  333.     mov    di, [tmp_reg.disp]
  334.     test    [(PORTDEF es:di).pflags], PORT_TYPE ; window object?
  335.     jnz    @@error
  336.     mov    ax, [(PORTDEF es:di).ulline]
  337.     mov    bx, [(PORTDEF es:di).ulcol]
  338.     mov    cx, [(PORTDEF es:di).nlines]
  339.     mov    dx, [(PORTDEF es:di).ncols]
  340.     mov    [wulline], ax
  341.     mov    [wulcol], bx
  342.     mov    [wnlines], cx
  343.     mov    [wncols], dx
  344.     mov    ax, [(PORTDEF es:di).border]
  345.     cmp    ax, -1            ; border attribute ?
  346.     je    @@noborder
  347.     lea    ax, [wulline]
  348.     lea    bx, [wulcol]
  349.     lea    cx, [wnlines]
  350.     lea    dx, [wncols]
  351.     call    adj4bord C, ax, cx, bx, dx ; adjust window region
  352. @@noborder:
  353.     restore <bx>
  354.     call    rest_scr C, bx, [wulline], [wulcol], [wnlines], [wncols]
  355.     jmp    next_pc
  356. ENDP    rest_win
  357.  
  358. ;************************************************************************
  359. ;*                  Set Window Attribute                *
  360. ;************************************************************************
  361. PROC C    set_window_attribute FAR USES si, @@regist:word, @@attrib:word, @@value:word
  362.     mov    ax, 1
  363.     call    get_port C, [@@regist], ax ; get port address
  364.     mov    bx, [tmp_reg.page]
  365.     cmp    [ptype+bx], PORTTYPE    ; check type
  366.     jne    @@error
  367.     mov    si, [@@attrib]
  368.     cmp    [(REG si).bpage], SPECFIX*2
  369.     jne    @@error
  370.     mov    ax, [(REG si).disp]    ; get attribute value
  371.     or    ax, ax             ; check attribute value
  372.     jl    @@error
  373.     cmp    ax, NUM_FLDS
  374.     jg    @@error
  375.     mov    si, [@@value]         ; get the value pointer
  376.     cmp    [(REG si).bpage], SPECFIX*2
  377.     je    @@noerror
  378.     cmp    ax, 13            ; special: set ptr
  379.     je    @@noerror
  380. @@error:
  381.     lea    bx, [$$msgreify]    ; address of error message
  382.     mov    ax, 3
  383.     call    set_src_error C, bx, ax, [@@regist], [@@attrib], [@@value]
  384.     mov    ax, -1             ; return error status
  385.     jmp    @@return
  386.  
  387. @@noerror:
  388.     mov    cx, [(REG si).disp]    ; get the value
  389.     ldpage    es, bx             ; get page address of port
  390.     mov    si, [tmp_reg.disp]    ; displacement of port object
  391.     mov    bx, ax
  392.     shl    bx, 1             ; get the word offset
  393.     jmp    [@@table+bx]
  394. DATASEG
  395. @@table    DW    @@cursor         ; [0] : cursor line
  396.     DW    @@cursor         ; [1] : cursor column
  397.     DW    @@ulline         ; [2] : upper left corner line
  398.     DW    @@ulcol         ; [3] : upper left corner column
  399.     DW    @@nlines         ; [4] : number of lines
  400.     DW    @@ncols         ; [5] : number of columns
  401.     DW    @@store         ; [6] : border attribute
  402.     DW    @@store         ; [7] : text attribute
  403.     DW    @@store         ; [8] : flags
  404.     DW    @@store         ; [9] : buffer position
  405.     DW    @@store         ; [10] : buffer end
  406.     DW    @@store         ; [11] : port flag
  407.     DW    @@chunks         ; [12] : # of chunks
  408.     DW    @@pointer        ; [13] : set ptr
  409. CODESEG
  410.  
  411. @@cursor:                ; cursor line/cursor column
  412.     or    cx, cx
  413.     jl    @@error         ; negative value, error
  414.     jmp    @@store
  415.  
  416. @@ulline:                ; upper left hand corner line number
  417.     push    cx
  418.     call    get_max_rows C
  419.     pop    cx
  420.     mov    dx, ax
  421.     xor    ax, ax
  422.     call    fit_in_r
  423.     mov    ax, [(PORTDEF es:si).nlines]
  424.     inc    dx
  425.     sub    dx, cx             ; max_rows - value
  426.     cmp    ax, dx
  427.     jle    @@store
  428.     mov    [(PORTDEF es:si).nlines], dx
  429. @@skip:
  430.     jmp    @@store
  431.  
  432. @@ulcol:                ; upper left hand corner column number
  433.     push    cx
  434.     call    get_max_cols C
  435.     pop    cx
  436.     mov    dx, ax
  437.     xor    ax, ax
  438.     call    fit_in_r
  439.     mov    ax, [(PORTDEF es:si).ncols]
  440.     sub    dx, cx             ; max_cols - value
  441.     cmp    ax, dx
  442.     jle    @@store
  443.     mov    [(PORTDEF es:si).ncols], dx
  444.     jmp    @@store
  445.  
  446. @@nlines:                ; number of lines
  447.     push    cx
  448.     call    get_max_rows C
  449.     pop    cx
  450.     inc    ax
  451.     mov    dx, [(PORTDEF es:si).ulline]
  452.     sub    dx, ax
  453.     neg    dx             ; max_rows - UL_LINE
  454.     mov    ax, 1
  455.     call    fit_in_r
  456.     jmp    @@store
  457.  
  458. @@ncols:                ; number of columns
  459.     test    [(PORTDEF es:si).pflags], PORT_TYPE ; window ?
  460.     jnz    @@store         ; no, jump
  461.     push    cx
  462.     call    get_max_cols C
  463.     pop    cx
  464.     mov    dx, [(PORTDEF es:si).ulcol]
  465.     sub    dx, ax
  466.     neg    dx             ; max_cols - UL_COL
  467.     mov    ax, 1
  468.     call    fit_in_r
  469.     jmp    @@store
  470.  
  471. @@chunks:                ; chunk#
  472.     lea    bx, [(PORTDEF es:si).chunk]
  473.     sub    bx, si
  474.     jmp    @@common
  475.  
  476. @@pointer:
  477.     mov    bx, [@@value]
  478.     mov    dx, [(REG bx).page]
  479.     mov    [(PORTDEF es:si).ptr.disp], cx
  480.     mov    [(PORTDEF es:si).ptr.page], dl
  481.     jmp    @@returnok
  482.  
  483. @@store:                ; store the value
  484.     sar    bx, 1
  485.     cmp    bx, 11
  486.     jne    @@not11
  487.     test    cx, 00010000b
  488.     jz    @@notrans
  489.     or    [(PORTDEF es:si).flags], W_TRANS
  490.     jmp    @@trans_done
  491. @@notrans:
  492.     and    [(PORTDEF es:si).flags], NOT W_TRANS
  493. @@trans_done:    
  494.     mov    ax, cx
  495.     and    cx, 10000000b
  496.     xor    cx, 10000000b
  497.     mov    bx, ax
  498.     and    bx, 00100000b
  499.     shl    bx, 1
  500.     or    cx, bx
  501.     test    ax, 00000100b
  502.     jz    @@file
  503.     test    ax, 01000000b
  504.     jz    @@window
  505.     or    cx, TYPE_STRING
  506.     jmp    @@type_done
  507. @@window:
  508.     or    cx, TYPE_WINDOW
  509.     jmp    @@type_done
  510. @@file:
  511.     or    cx, TYPE_FILE
  512. @@type_done:
  513.     test    ax, 00001000b
  514.     jz    @@mode_done
  515.     inc    ax
  516.     test    ax, 00000010b
  517.     jz    @@readonly
  518.     or    cx, WRITE_EXCLUSIVE
  519. @@readonly:
  520.     test    ax, 00000001b
  521.     jz    @@mode_done
  522.     or    cx, READ_EXCLUSIVE
  523. @@mode_done:
  524.     mov    bx, 6
  525.     jmp    @@common
  526. @@not11:
  527.     shl    bx, 1             ; word offset
  528.     add    bx, 10
  529. @@common:
  530.     mov    [es:si+bx], cx        ; store the value
  531. @@returnok:
  532.     xor    ax, ax
  533. @@return:
  534.     ret
  535. ENDP    set_window_attribute
  536.  
  537. ;************************************************************************
  538. ;        Force Value into Range                    *
  539. ;  Purpose: To test a value (in cx) to determine if it falls within a    *
  540. ;           range of values, as specified by an lower (in ax) and    *
  541. ;           upper (in dx) bounds. If the value is within the range,    *
  542. ;           the value is returned (in cx) unchanged. If it is outside    *
  543. ;           the range, the value of the endpoint nearest its value    *
  544. ;           is returned (in cx).                    *
  545. ;************************************************************************
  546. PROC    fit_in_r
  547.     cmp    cx, ax             ; value < lower?
  548.     jge    @@notsmaller
  549.     mov    cx, ax             ; yes, return lower
  550.     ret
  551. @@notsmaller:
  552.     cmp    cx, dx             ; value > upper?
  553.     jle    @@notbigger
  554.     mov    cx, dx             ; yes, return upper
  555. @@notbigger:
  556.     ret
  557. ENDP    fit_in_r
  558.  
  559. ;************************************************************************
  560. ;*        Get maximum number of text rows                *
  561. ;*    This local subroutine detects the maximum number of rows    *
  562. ;************************************************************************
  563. PROC C    get_max_rows FAR USES si di es
  564.     mov    ax, 40h            ; BIOS data area
  565.     mov    es, ax
  566.     mov    al, [BYTE es:84h]    ; if we're lucky enough...
  567.     or    al, al            ; that's it.
  568.     jnz    @@gotit
  569.     mov    ax, 1130h        ; get font information
  570.     xor    bh, bh            ; current int1f contents
  571.     mov    dl, 24            ; default value for CGA & Hercules
  572.     int    10h
  573.     mov    al, dl
  574. @@gotit:
  575.     mov    ah, 0
  576.     ret
  577. ENDP    get_max_rows
  578.  
  579. ;************************************************************************
  580. ;*        Get maximum number of text columns            *
  581. ;*    This local subroutine detects the maximum number of columns    *
  582. ;************************************************************************
  583. PROC C    get_max_cols FAR USES si di
  584.     mov    ah, 0fh            ; get current video mode & infos
  585.     int    10h
  586.     mov    al, ah
  587.     mov    ah, 0
  588.     ret
  589. ENDP    get_max_cols
  590.  
  591.     END
  592.  
  593.